home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / bbsutil / dlx70bbs.zip / DLX70SRC.ZIP / SCRIPT2A.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-19  |  18KB  |  484 lines
  1. {$debug-}
  2. {$line-}
  3.  
  4. {$include: 'types.int'}
  5. {$include: 'globals.int'}
  6. {$include: 'utils.int'}
  7. {$include: 'funs.int'}
  8. {$include: 'fs_pkg.int'}
  9. {$include: 'database.int'}
  10. {$include: 'load.int'}
  11. {$include: 'script2a.int'}
  12.  
  13. IMPLEMENTATION OF script2a;
  14.  
  15. USES types,globals,utils,funs,fs_pkg,database,load;
  16.  
  17. {DLX Bulletin Board System V7.0
  18.  
  19.  FREEWARE NOTICE
  20.  
  21.  DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
  22.  Anyone who wishes to may run the program, copy it, or modify it for
  23.  any purpose, including commercial gain.}
  24.  
  25. {***INTERFACE TO THE COM_PAX2 ASYNCHRONOUS COMMUNICATIONS PACKAGE***}
  26. {$include: 'com_pax2.int'}
  27.  
  28. {***Interface to the PASASM assembler utilities package***}
  29. {$include: 'pasasm.int'}
  30. {$include: 'newasm.int'}
  31.  
  32. var
  33.   doseqq [EXTERN]: word;
  34.  
  35. function kmatch(consts pat,info : lstring) : boolean;
  36. var
  37.   i,j,k : integer;
  38.   patty,cappy : lstring(screen_cols);
  39. begin
  40.   if pat.len=0 then [kmatch:=true; return];
  41.   kmatch:=false;
  42.   if info.len=0 then return;
  43.   ucs(info,cappy);
  44.   i:=1; j:=ord(pat.len)+1;
  45.   while i<=ord(pat.len) do begin
  46.     if pat[i]=' ' then [i:=i+1; cycle];
  47.     j:=i+scaneq(ord(pat.len)-i,' ',pat,i);
  48.     if j>=ord(pat.len) then [j:=ord(pat.len)+1; break];
  49.     patty.len:=wrd(j-i);
  50.     movesl(ads pat[i],ads patty[1],patty.len);
  51.     k:=positn(patty,cappy,1);
  52.     if k=0
  53.       then return
  54.       else cappy[k]:='x'; {this forbids duplicate key matches}
  55.     i:=j+1; j:=ord(pat.len)+1;
  56.   end {while};
  57.   patty.len:=wrd(j-i);
  58.   movesl(ads pat[i],ads patty[1],patty.len);
  59.   if positn(patty,cappy,1)=0 then return;
  60.   kmatch:=true;
  61. end {kmatch};
  62.  
  63. procedure bbs2a{consts s : lstring; var str : lstring};
  64. var
  65.   i,j,k : integer;
  66.   next_state : task;
  67.   p,p2,p3 : para;
  68.   i4 : integer4;
  69.   fl : boolean;
  70. begin
  71.   next_state:=succ(q[wx].state);
  72.   case q[wx].state of
  73.   delete_old:
  74.     if s=null then
  75.       next_state:=q[wx].return_state
  76.     else if number_query(s,1,MAXINT,q[wx].count) then
  77.       q[wx].index:=0
  78.     else
  79.       [display(bad_userid_txt); next_state:=q[wx].return_state];
  80.   delete_old2:
  81.     [q[wx].index:=q[wx].index+1;
  82.      if q[wx].index<=largest_member_number then
  83.        [if disk2u(q[wx].index) then
  84.           [i4:=date2jd(w^[wx].date_of_call) -
  85.                date2jd(q[wx].your.last_called_date);
  86.            if ord(i4)>=q[wx].count
  87.              then prompt_with(user_delete_txt)
  88.              else next_state:=delete_old2]
  89.         else
  90.           next_state:=delete_old2]
  91.      else
  92.        next_state:=q[wx].return_state];
  93.   delete_old3:
  94.     if nagree(s) then
  95.       [q[wx].your.active:=' ';
  96.        i:=on_line(q[wx].index);
  97.        if i>=0 then
  98.          [w^[i].state:=stopping; q[i].my.active[1]:=' ']
  99.        else
  100.          dbp_member(q[wx].index,q[wx].your);
  101.        mbx(mailpath,q[wx].your.userid,str); mail_delete(str);
  102.        mbx(biopath,q[wx].your.userid,str); mail_delete(str);
  103.        number_of_members:=number_of_members-1;
  104.        display(user_deleted_txt); next_state:=delete_old2]
  105.     else
  106.       next_state:=delete_old2;
  107.   change_level:
  108.     if s=null then
  109.       next_state:=q[wx].return_state
  110.     else if number_query(s,1,largest_member_number,i) then
  111.       [if disk2u(i)
  112.          then prompt_with(enter_level_txt)
  113.          else [display(bad_userid_txt); next_state:=q[wx].return_state]]
  114.     else
  115.       [display(bad_userid_txt); next_state:=q[wx].return_state];
  116.   change_level2:
  117.     if number_query(s,0,9,j) then
  118.       [q[wx].your.userlevel[1]:=chr(ord('0')+j);
  119.        i:=on_line(ivalue(q[wx].your.userid)); q[wx].index:=j;
  120.        if i>=0 then
  121.          [q[i].level:=j; q[i].my.userlevel[1]:=chr(ord('0')+j);
  122.       notify(i,new_level_txt)]
  123.        else
  124.          dbp_member(ivalue(q[wx].your.userid),q[wx].your);
  125.        display(level_changed_txt); next_state:=q[wx].return_state]
  126.     else
  127.       [display(bad_level_txt); next_state:=q[wx].return_state];
  128.   change_mbx:
  129.     [next_state:=q[wx].return_state;
  130.      if s<>null then
  131.        [if number_query(s,1,largest_member_number,i) then
  132.           [if disk2u(i) then
  133.          [q[wx].index:=ivalue(q[wx].your.mbx_max);
  134.           prompt_with(mbx_size_txt); next_state:=change_mbx2]
  135.        else
  136.          display(bad_userid_txt)]
  137.         else
  138.           display(bad_userid_txt)]];
  139.   change_mbx2:
  140.     [next_state:=q[wx].return_state;
  141.      if number_query(s,0,999,q[wx].index) and then
  142.         encode(str,q[wx].index:3) then
  143.        [kopystr(str,q[wx].your.mbx_max);
  144.         i:=on_line(ivalue(q[wx].your.userid));
  145.         if i>=0
  146.           then kopystr(str,q[i].my.mbx_max)
  147.           else dbp_member(ivalue(q[wx].your.userid),q[wx].your);
  148.         display(size_changed_txt)]
  149.      else
  150.        display(bad_size_txt)];
  151.   kill_line:
  152.     if number_query(s,0,number_of_lines,q[wx].index) and then
  153.        w^[q[wx].index].active then
  154.       prompt_with(line_kill_txt)
  155.     else
  156.       [display(bad_line_txt); next_state:=main_menu];
  157.   kill_line2:
  158.     [next_state:=main_menu;
  159.      if agree(s) then
  160.        [if w^[q[wx].index].state=going then
  161.       [w^[q[wx].index].state:=stopping;
  162.        i:=w^[q[wx].index].chat;
  163.        if i>=0 then w^[i].chat:=-1;
  164.        w^[q[wx].index].chat:=-1;
  165.        display(line_killed_txt)]
  166.     else if q[wx].index>0 then {modem line}
  167.       [select_port(q[wx].index); dtr_off;
  168.        if wx>0 then select_port(wx);
  169.            w^[q[wx].index].reset_count:=0;
  170.        if w^[q[wx].index].talking_to = cls
  171.          then w^[q[wx].index].talking_to:=modem
  172.          else w^[q[wx].index].talking_to:=SUCC(w^[q[wx].index].talking_to);
  173.        display(line_killed_txt)]]];
  174.   recycle:
  175.     if number_query(s,1,largest_member_number,q[wx].index) then
  176.       [last_new_user:=q[wx].index-1;
  177.        display(good_recycle_txt); next_state:=main_menu]
  178.     else
  179.       [display(bad_recycle_txt); next_state:=main_menu];
  180.   reset_time:
  181.     [next_state:=q[wx].return_state;
  182.      if s<>null then
  183.        [if number_query(s,1,largest_member_number,i) and then disk2u(i)
  184.           then [prompt_with(reset_really_txt); next_state:=reset_time2]
  185.           else display(bad_userid_txt)]];
  186.   reset_time2:
  187.     [fl:=false; next_state:=q[wx].return_state;
  188.      if agree(s) then
  189.        [copystr('0',q[wx].your.minutes_today); fl:=true];
  190.      if fl then  
  191.        [i:=ivalue(q[wx].your.userid);
  192.     j:=on_line(i);
  193.     if j>=0 then
  194.       [w^[j].connect_sec0:=jt; q[j].minutes_on:=0;
  195.        copystr('0',q[j].my.minutes_today); q[j].minutes_2day:=0]
  196.     else
  197.       dbp_member(i,q[wx].your);
  198.     display(time_reset_txt)]];
  199.   unans1:
  200.     if s=null then
  201.       next_state:=main_menu
  202.     else if number_query(s,1,largest_member_number,i) then
  203.       [if disk2u(i)
  204.          then prompt_with(enter_multiple_txt)
  205.          else [display(bad_userid_txt); next_state:=main_menu]]
  206.     else
  207.       [display(bad_userid_txt); next_state:=main_menu];
  208.   unans2:
  209.     if number_query(s,1,number_of_qaires,j) then
  210.       [for k:=1 to number_of_answers do q[wx].your.mult_answer[j][k]:=' ';
  211.        if j=1 then q[wx].your.mult_answer[1][1]:='Z';
  212.        i:=on_line(ivalue(q[wx].your.userid)); q[wx].index:=j;
  213.        if i>=0 then
  214.          [for k:=1 to number_of_answers do q[i].my.mult_answer[j][k]:=' ';
  215.           if j=1 then q[i].my.mult_answer[1][1]:='Z']
  216.        else
  217.          dbp_member(ivalue(q[wx].your.userid),q[wx].your);
  218.        display(qaire_cleared_txt); next_state:=main_menu]
  219.     else
  220.       [display(bad_multiple_txt); next_state:=main_menu];
  221.   down1:
  222.     [if number_query(s,1,1440,i) then
  223.        [doseqq:=1; shut_down(i)];
  224.      next_state:=main_menu];
  225.   answer:
  226.     [if q[wx].level>=priv_bio
  227.        then display(reans_essay_txt);
  228.      q[wx].qr:=1];
  229.   answer2:
  230.     [if qair[q[wx].qr]<>nil and then
  231.         ((q[wx].level=9) or (q[wx].my.mult_answer[q[wx].qr][1]<>' '))
  232.        then display(reans_mult_txt);
  233.      q[wx].qr:=q[wx].qr+1;
  234.      if q[wx].qr<=number_of_qaires then next_state:=answer2];
  235.   answer3:
  236.     prompt_with(arrow_txt);
  237.   answer4:
  238.     [if str=null or else str[1]=mn[14][2] {Q} then
  239.        next_state:=main_menu
  240.      else if str[1]=mn[14][3] {M} then
  241.        [display(qaire_header_txt); next_state:=questionnaire]
  242.      else if str[1]=mn[14][4] {E} then
  243.        [if q[wx].l